home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / run-mailcap < prev    next >
Text File  |  2009-09-09  |  17KB  |  557 lines
  1. #! /usr/bin/perl
  2. ###############################################################################
  3. #
  4. #  Run-Mailcap:  Run a program specified in the mailcap file based on a mime
  5. #  type.
  6. #
  7. #  Written by Brian White <bcwhite@pobox.com>
  8. #  This file has been placed in the public domain (the only true "free").
  9. #
  10. ###############################################################################
  11.  
  12.  
  13. $debug=0;
  14. $norun=0;
  15. $etcmimetyp="/etc/mime.types";
  16. $shrmimetyp="/usr/share/etc/mime.types";
  17. $locmimetyp="/usr/local/etc/mime.types";
  18. $usrmimetyp="$ENV{HOME}/.mime.types";
  19. $xtermprgrm="/usr/bin/x-terminal-emulator"; # xterm?
  20. $defmimetyp="application/octet-stream";
  21. $quotedsemi=chr(255);
  22. $quotedprct=chr(254);
  23. $retcode=0;
  24.  
  25.  
  26. %patterntypes =
  27. (
  28.  '(^|/)crontab[^/]+$'                           => 'text/x-crontab',            #'
  29.  '/man\d*/'                                     => 'application/x-troff-man',   #'
  30.  '\.\d[^\.]*$'                                  => 'application/x-troff-man',   #'
  31. );
  32.  
  33.  
  34.  
  35. sub Usage {
  36.     my($error) = @_;
  37.     print STDERR $error,"\n\n" if $error;
  38.  
  39.     print STDERR "Use: $0 <--action=VAL> [--debug] [MIME-TYPE:[ENCODING:]]FILE [...]\n\n";
  40.     print STDERR "Options:\n";
  41.     print STDERR "  action        specify what action to do on these files (default=view)\n";
  42.     print STDERR "  debug         be verbose about what's going on\n";
  43.     print STDERR "  norun         just print but don't execute the command (useful with --debug)\n";
  44.     print STDERR "\n";
  45.     print STDERR "Mime-Type:\n";
  46.     print STDERR "  any standard mime type designation in the form <class>/<subtype> -- if\n";
  47.     print STDERR "  not specified, it will be determined from the filename extension\n\n";
  48.     print STDERR "Encoding:\n";
  49.     print STDERR "  how the file (and type) has been encoded (only \"gzip\", \"bzip\", \"bzip2\"\n";
  50.     print STDERR "  and \"compress\" are supported) -- if not specified, it will be determined\n";
  51.     print STDERR "  from the filename extension\n\n";
  52.  
  53.     exit ($error ? 1 : 0);
  54. }
  55.  
  56.  
  57.  
  58. sub EncodingForFile {
  59.     my($file) = @_;
  60.     my $encoding;
  61.  
  62.     if ($file =~ m/\.gz$/)  { $encoding = "gzip";       }
  63.     if ($file =~ m/\.bz$/)  { $encoding = "bzip";       }
  64.     if ($file =~ m/\.bz2$/) { $encoding = "bzip2";      }
  65.     if ($file =~ m/\.Z$/)   { $encoding = "compress";   }
  66.  
  67.     print STDERR " - file \"$file\" has encoding \"$encoding\"\n" if $debug && $encoding;
  68.  
  69.     return $encoding;
  70. }
  71.  
  72.  
  73.  
  74. sub ReadMimetypes {
  75.     my($file) = @_;
  76.  
  77.     return unless -r $file;
  78.  
  79.     print STDERR " - Reading mime.types file \"$file\"...\n" if $debug;
  80.     open(MIMETYPES,"<$file") || die "Error: could not read \"$file\" -- $!\n";
  81.     while (<MIMETYPES>) {
  82.         chomp;
  83.         s/\#.*$//;
  84.         next if (m/^\s*$/);
  85.  
  86.         $_=lc($_);
  87.         my($type,@exts) = split;
  88.  
  89.         foreach (@exts) {
  90.             $mimetypes{$_} = $type unless exists $mimetypes{$_};
  91.         }
  92.     }
  93.     close MIMETYPES;
  94. }
  95.  
  96.  
  97.  
  98. sub ReadMailcap {
  99.     my($file) = @_;
  100.     my $line = "";
  101.  
  102.     return unless -r $file;
  103.  
  104.     print STDERR " - Reading mailcap file \"$file\"...\n" if $debug;
  105.     open(MAILCAP,"<$file") || die "Error: could not read \"$file\" -- $!\n";
  106.     while (<MAILCAP>) {
  107.         chomp;
  108.         s/^\s+// if $line;
  109.         $line .= $_;
  110.         next unless $line;
  111.         if ($line =~ m/^\s*\#/) {
  112.             $line = "";
  113.             next;
  114.         }
  115.         if ($line =~ m/\\$/) {
  116.             $line =~ s/\\$//;
  117.         } else {
  118.             $line =~ s/\\;/$quotedsemi/go;
  119.             $line =~ s/\\%/$quotedprct/go;
  120.             push @mailcap,$line;
  121.             $line = "";
  122.         }
  123.     }
  124.     close MAILCAP;
  125. }
  126.  
  127.  
  128.  
  129. sub TempFile {
  130.     my($template) = @_;
  131.     my($cmd,$head,$tail,$tmpfile);
  132.     $template = "" unless (defined $template);
  133.  
  134.     ($head,$tail) = split(/%s/,$template,2);
  135.  
  136. #   $tmpfile = POSIX::tmpnam($name);
  137. #   unlink($tmpfile);
  138.  
  139.     $cmd  = "tempfile --mode=600";
  140.     $cmd .= " --prefix $head" if $head;
  141.     $cmd .= " --suffix $tail" if $tail;
  142.  
  143.     $tmpfile = `$cmd`;
  144.     chomp($tmpfile);
  145.  
  146. #   $tmpfile = $ENV{TMPDIR};
  147. #   $tmpfile = "/tmp" unless $tmpfile;
  148. #   $tmpfile.= "/$name";
  149. #   unlink($tmpfile);
  150.  
  151.     return $tmpfile;
  152. }
  153.  
  154.  
  155.  
  156. sub SaveStdin {
  157.     my($match) = @_;
  158.     my($tmpfile,$amt,$buf);
  159.  
  160.     $tmpfile = $1 if ($match =~ m/nametemplate=(.*?)\s*($|;)/);
  161.     $tmpfile = TempFile($tmpfile);
  162.     open(TMPFILE,">$tmpfile") || die "Error: could not write \"$tmpfile\" -- $!\n";
  163.     do {
  164.         $amt = read(STDIN,$buf,102400);
  165.         print TMPFILE $buf if $amt;
  166.     } while ($amt != 0);
  167.     close(TMPFILE);
  168.  
  169.     return $tmpfile;
  170. }
  171.  
  172.  
  173.  
  174. sub DecodeFile {
  175.     my($efile,$encoding,$action) = @_;
  176.     my($file,$res);
  177.  
  178.     $file = $efile;
  179.     $file =~ s!^.*/!!;          # remove leading directories
  180.     $file =~ s!\.[^\.]*$!!;     # remove encoding extension
  181.     $file =~ s!^\.?[^\.]*!%s!;  # replace name with placeholder
  182.     $file = undef if ($efile eq '-');
  183.     my $tmpfile = TempFile($file);
  184.  
  185.     print STDERR " - decoding \"$efile\" as \"$tmpfile\"\n" if $debug;
  186.  
  187. #   unlink($tmpfile); # should still be acceptable for "compose" output even if exists
  188.     return $tmpfile if (($efile ne '-' && ! -e $efile) || $action eq 'compose');
  189.  
  190.     if ($encoding eq "gzip") {
  191.         if ($efile eq '-') {
  192.             $res = system "gzip -d >\Q$tmpfile\E";
  193.         } else {
  194.             $res = system "gzip -dc \Q$efile\E >\Q$tmpfile\E";
  195.         }
  196.     } elsif ($encoding eq "bzip") {
  197.         if ($efile eq '-') {
  198.             $res = system "bzip -d >\Q$tmpfile\E";
  199.         } else {
  200.             $res = system "bzip -dc <\Q$efile\E >\Q$tmpfile\E";
  201.         }
  202.     } elsif ($encoding eq "bzip2") {
  203.         if ($efile eq '-') {
  204.             $res = system "bzip2 -d >\Q$tmpfile\E";
  205.         } else {
  206.             $res = system "bzip2 -dc <\Q$efile\E >\Q$tmpfile\E";
  207.         }
  208.     } elsif ($encoding eq "compress") {
  209.         if ($efile eq '-') {
  210.             $res = system "uncompress >\Q$tmpfile\E";
  211.         } else {
  212.             $res = system "uncompress <\Q$efile\E >\Q$tmpfile\E";
  213.         }
  214.     } else {
  215.         die "Fatal: unknown encoding \"$encoding\" at";
  216.     }
  217.  
  218.     $res = int($res/256);
  219.     if ($res != 0) {
  220.         print STDERR "Error: could not decode \"$efile\" -- $!\n";
  221.         $retcode = 2 if ($retcode < 2);
  222.         unlink($tmpfile);
  223.         return;
  224.     }
  225.  
  226. #   chmod 0600,$tmpfile; # done already by TempFile
  227.     return $tmpfile;
  228. }
  229.  
  230.  
  231.  
  232. sub EncodeFile {
  233.     my($dfile,$efile,$encoding) = @_;
  234.     my($res);
  235.  
  236.     print STDERR " - encoding \"$dfile\" as \"$efile\"\n";
  237.  
  238.     if ($encoding eq "gzip") {
  239.         if ($efile eq '-') {
  240.             $res = system "gzip -c \Q$dfile\E";
  241.         } else {
  242.             $res = system "gzip -c \Q$dfile\E >\Q$efile\E";
  243.         }
  244.     } elsif ($encoding eq "compress") {
  245.         if ($efile eq '-') {
  246.             $res = system "compress <\Q$dfile\E";
  247.         } else {
  248.             $res = system "compress <\Q$dfile\E >\Q$efile\E";
  249.         }
  250.     } else {
  251.         die "Fatal: unknown encoding \"$encoding\" at";
  252.     }
  253.  
  254.     $res = int($res/256);
  255.     if ($res != 0) {
  256.         print STDERR "Error: could not encode \"$efile\" (left as \"$dfile\")\n";
  257.         $retcode = 2 if ($retcode < 2);
  258.         return;
  259.     }
  260.  
  261.     return $dfile;
  262. }
  263.  
  264.  
  265.  
  266. sub ExtensionMimetype {
  267.     my($ext) = @_;
  268.     my($typ);
  269.  
  270.     unless ($donemimetypes) {
  271.         ReadMimetypes($usrmimetyp);
  272.         ReadMimetypes($locmimetyp);
  273.         ReadMimetypes($shrmimetyp);
  274.         ReadMimetypes($etcmimetyp);
  275.         $donemimetypes = 1;
  276.     }
  277.  
  278.     $typ = $mimetypes{lc($ext)};
  279.  
  280.     print STDERR " - extension \"$ext\" maps to mime-type \"$typ\"\n" if $debug;
  281.     return $typ;
  282. }
  283.  
  284.  
  285.  
  286. sub PatternMimetype {
  287.     my($file) = @_;
  288.     my($key,$val);
  289.  
  290.     while (($key,$val) = each %patterntypes) {
  291.         if ($file =~ m!$key!i) {
  292.             print STDERR " - file \"$file\" maps to mime-type \"$val\"\n" if $debug;
  293.             return $val;
  294.         }
  295.     }
  296.  
  297.     print STDERR " - file \"$file\" does not conform to any known pattern\n" if $debug;
  298.     return;
  299. }
  300.  
  301.  
  302.  
  303. sub FileMimetype {
  304.     my($file) = @_;
  305.     my($ext)  = ($file =~ m!\.([^/\.]+)$!);
  306.  
  307.     my $type;
  308.  
  309.     $type = ExtensionMimetype($ext) if $ext;
  310.     $type = PatternMimetype($file) unless $type;
  311.  
  312.     return $type;
  313. }
  314.  
  315.  
  316.  
  317. @files = ();
  318. foreach (@ARGV) {
  319.     print STDERR " - parsing parameter \"$_\"\n" if $debug;
  320.     if (m!^(-h|--help)$!) {
  321.         Usage();
  322.         exit(0);
  323.     } elsif (m!^--(.*?)=(.*)$!) {
  324.         print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != $2);
  325.         $ {$1}=$2;
  326.     } elsif (m!^--(.*?)$!) {
  327.         print STDERR "Warning: definition of \"$1=$2\" overrides value \"${$1}\"\n" if ($ {$1} && $ {$1} != 1);
  328.         $ {$1}=1;
  329.     } elsif (m!^[^/:]+/[^/:]+:[^/:]+:!) {
  330.         push @files,$_;
  331.     } elsif (m!^([^/:]+/[^/:]+):(.*)! && ! -e $_) {
  332.         my $file = $_;
  333.         my $type = $1;
  334.         my $file = $2;
  335.         my $code = EncodingForFile($file);
  336.         push @files,"${type}:${code}:${file}";
  337.         print STDERR " - file \"$file\" does not exist -- assuming mime-type specification of \"${type}\"\n" if $debug;
  338.     } else {
  339.         my $file = $_;
  340.         my $code = EncodingForFile($file);
  341.         my $type;
  342.         if ($code) {
  343.             my $efile = $file;
  344.             $efile =~ s/\.[^\.]+$//;
  345.             $type = FileMimetype($efile);
  346.         } else {
  347.             $type = FileMimetype($file);
  348.         }
  349.         if ($type) {
  350.             push @files,"${type}:${code}:${file}";
  351.         } else {
  352.             print STDERR "Warning: unknown mime-type for \"$file\" -- using \"$defmimetyp\"\n";
  353.             push @files,"${defmimetyp}:${code}:${file}";
  354.         }
  355.     }
  356. }
  357.  
  358. unless ($action) {
  359.        if ($0 =~ m!(^|/)view$!)     { $action="view";   }
  360.     elsif ($0 =~ m!(^|/)see$!)      { $action="view";   }
  361.     elsif ($0 =~ m!(^|/)cat$!)      { $action="cat";    }
  362.     elsif ($0 =~ m!(^|/)edit$!)     { $action="edit";   }
  363.     elsif ($0 =~ m!(^|/)change$!)   { $action="edit";   }
  364.     elsif ($0 =~ m!(^|/)compose$!)  { $action="compose";}
  365.     elsif ($0 =~ m!(^|/)print$!)    { $action="print";  }
  366.     elsif ($0 =~ m!(^|/)create$!)   { $action="compose";}
  367.     else                            { $action="view";   }
  368. }
  369.  
  370.  
  371. $mailcaps = $ENV{MAILCAPS};
  372. $mailcaps = "$ENV{HOME}/.mailcap:/etc/mailcap:/usr/local/etc/mailcap:/usr/share/etc/mailcap:/usr/etc/mailcap" unless $mailcaps;
  373. foreach (split(/:/,$mailcaps)) {
  374.     ReadMailcap($_);
  375. }
  376.  
  377. foreach (@files) {
  378.     my($type,$code,$file) = m/^(.*?):(.*?):(.*)$/;
  379.     print STDERR "Processing file \"$file\" of type \"$type\" (encoding=",$code?$code:"none",")...\n" if $debug;
  380.  
  381.     if ($file ne '-') {
  382.         if ($action eq 'compose' || $action eq 'edit') {
  383.             if (-e $file) {
  384.                 if (! -w $file) {
  385.                     print STDERR "Error: no write permission for file \"$file\"\n";
  386.                     $retcode = 2 if ($retcode < 2);
  387.                     next;
  388.                 }
  389.             } else {
  390.                 if (open(TEST,">$file")) {
  391.                     close(TEST);
  392.                     unlink($file);
  393.                 } else {
  394.                     print STDERR "Error: no write permission for file \"$file\"\n";
  395.                     $retcode = 2 if ($retcode < 2);
  396.                     next;
  397.                 }
  398.             }
  399.         } else {
  400.             if (! -e $file) {
  401.                 print STDERR "Error: no such file \"$file\"\n";
  402.                 $retcode = 2 if ($retcode < 2);
  403.                 next;
  404.             }
  405.             if (! -r $file) {
  406.                 print STDERR "Error: no read permission for file \"$file\"\n";
  407.                 $retcode = 2 if ($retcode < 2);
  408.                 next;
  409.             }
  410.         }
  411.     }
  412.  
  413.     my(@matches,$entry,$res,$efile);
  414.     if ($code) {
  415.         $efile = $file;
  416.         $file  = DecodeFile($efile,$code,$action);
  417.         next unless $file;
  418.     }
  419.  
  420.     foreach $entry (@mailcap) {
  421.         $entry =~ m/^(.*?)\s*;/;
  422.         $_ = "\Q$1\E"; s/\\\*/\.\*/g;
  423.         push @matches,$entry if ($type =~ m!^$_$!i);
  424.     }
  425.     @matches = grep(/\Q$action\E=/,@matches) unless ($action eq "view" || $action eq "cat");
  426.  
  427.     my $done=0;
  428.     my $fail=0;
  429.     foreach $match (@matches) {
  430.         my $comm;
  431.         print STDERR " - checking mailcap entry \"$match\"\n" if $debug;
  432.         if ($action eq "view" || $action eq "cat") {
  433.             ($comm) = ($match =~ m/^.*?;\s*(.*?)\s*($|;)/);
  434.         } else {
  435.             ($comm) = ($match =~ m/\Q$action\E=(.*?)\s*($|;)/);
  436.         }
  437.         next if (!$comm || $comm =~ m!(^|/)false$!i);
  438.         print STDERR " - program to execute: $comm\n" if $debug;
  439.  
  440.         if ($match =~ m/;\s*test=(.*?)\s*($|;)/) {
  441.             my $test;
  442.             print STDERR " - running test: $1 " if $debug;
  443.             $test   = system "$1 >/dev/null 2>&1";
  444.             $test >>= 8;
  445.             print STDERR " (result=$test=",($test!=0?"false":"true"),")\n" if $debug;
  446.             if ($test) {
  447.                 $fail++;
  448.                 next;
  449.             }
  450.         }
  451.  
  452.         my($tmpfile,$tmplink);
  453.         if ($action ne 'print' && $match =~ m/;\s*needsterminal\s*($|;)/ && ! -t STDOUT) {
  454.             if ($ENV{DISPLAY}) {
  455.                 $comm = "$xtermprgrm -T '$file ($type)' -e $0 --action=$action '${type}:%s'";
  456.             } else {
  457.                 print STDERR " - no terminal available for rule (needsterminal)\n" if $debug;
  458.                 $fail++;
  459.                 next;
  460.             }
  461.         } elsif ($action eq 'view' && $match =~ m/;\s*copiousoutput\s*($|;)/ && $type ne 'text/plain') {
  462.             $comm .= " | $0 --action=$action text/plain:-";
  463.         }
  464.  
  465.         if ($file ne "-") {
  466.             if ($comm =~ m/[^%]%s/) {
  467.                 if ($file =~ m![^ a-z0-9,.:/@%^+=_-]!i) {
  468.                     $match =~ m/nametemplate=(.*?)\s*($|;)/;
  469.                     my $prefix = $1;
  470.                     my $linked = 0;
  471.                     while (!$linked) {
  472.                         $tmplink = TempFile($prefix);
  473.                         unlink($tmplink);
  474.                         if ($file =~ m!^/!) {
  475.                             $linked = symlink($file,$tmplink);
  476.                         } else {
  477.                             my $pwd = `/bin/pwd`;
  478.                             chomp($pwd);
  479.                             $linked = symlink("$pwd/$file",$tmplink);
  480.                         }
  481.                     }
  482.                     print STDERR " - filename contains shell meta-characters; aliased to '$tmplink'\n" if $debug;
  483.                     $comm =~ s/([^%])%s/$1$tmplink/g;
  484.                 } else {
  485.                     $comm =~ s/([^%])%s/$1$file/g;
  486.                 }
  487.             } else {
  488.                 if ($comm =~ m/\|/) {
  489.                     $comm =~ s/\|/<\Q$file\E \|/;
  490.                 } else {
  491.                     $comm .= " <\Q$file\E";
  492.                 }
  493.                 if ($action eq 'edit' || $action eq 'compose') {
  494.                     $comm .= " >\Q$file\E";
  495.                 }
  496.             }
  497.         } else {
  498.             if ($comm =~ m/[^%]%s/) {
  499.                 $tmpfile = SaveStdin($match);
  500.                 $comm =~ s/([^%])%s/$1$tmpfile/g;
  501.             } else {
  502.                 # no name means same as "-"... read from stdin
  503.             }
  504.         }
  505.  
  506.         $comm =~ s!([^%])%t!$1$type!g;
  507.         $comm =~ s!([^%])%F!$1!g;
  508.         $comm =~ s!%{(.*?)}!$_="'$ENV{$1}'";s/\`//g;s/\'\'//g;$_!ge;
  509.         $comm =~ s!\\(.)!$1!g;
  510.         $comm =~ s!\'\'!\'!g;
  511.         $comm =~ s!$quotedsemi!;!go;
  512.         $comm =~ s!$quotedprct!%!go;
  513.  
  514.         print STDERR " - executing: $comm\n" if $debug;
  515.     if ($norun) {
  516.         print $comm,"\n";
  517.         $res = 0;
  518.     } else {
  519.         $res = system $comm;
  520.         $res = int($res/256);
  521.     }
  522.         if ($res != 0) {
  523.             print STDERR "Warning: program returned non-zero exit code \#$res\n";
  524.             $retcode = $res;
  525.         }
  526.         $done=1;
  527.         unlink $tmpfile if $tmpfile;
  528.         unlink $tmplink if $tmplink;
  529.         last;
  530.     }
  531.  
  532.     if (!$done) {
  533.         if ($fail) {
  534.             print STDERR "Error: no \"$action\" rule for type \"$type\" passed its test case\n";
  535.             print STDERR "       (for more information, add \"--debug=1\" on the command line)\n";
  536.             $retcode = 3 if ($retcode < 3);
  537.         } else {
  538.             print STDERR "Error: no \"$action\" mailcap rules found for type \"$type\"\n";
  539.             $retcode = 3 if ($retcode < 3);
  540.         }
  541.         unlink $file if $code;
  542.         $retcode = 1 unless $retcode;
  543.         next;
  544.     }
  545.  
  546.     if ($code) {
  547.         if ($action eq 'edit' || $action eq 'compose') {
  548.             my $file = EncodeFile($file,$efile,$code);
  549.             unlink $file if $file;
  550.         } else {
  551.             unlink $file;
  552.         }
  553.     }
  554. }
  555.  
  556. exit($retcode);
  557.